home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-flag.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-12-03  |  2.8 KB  |  155 lines
  1. /*  $Id: pl-flag.c,v 1.11 1997/12/03 08:52:00 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: implement flag/3
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. typedef struct flag *    Flag;
  13.  
  14. #define FLG_ATOM    0
  15. #define FLG_INTEGER    1
  16. #define FLG_REAL    2
  17.  
  18. struct flag
  19. { word    key;                /* key to the flag */
  20.   int    type;                /* type (atom, int, real */
  21.   union
  22.   { atom_t a;                /* atom */
  23.     long   i;                /* integer */
  24.     double f;                /* float */
  25.   } value;                /* value of the flag */
  26. };
  27.  
  28. #define flagTable (GD->flags.table)
  29.  
  30. forwards Flag lookupFlag(word);
  31.  
  32. void
  33. initFlags(void)
  34. { flagTable = newHTable(FLAGHASHSIZE);
  35. }
  36.  
  37. static Flag
  38. lookupFlag(word key)
  39. { Symbol symb;
  40.   Flag f;
  41.  
  42.   if ( (symb = lookupHTable(flagTable, (void *)key)) )
  43.     return (Flag)symb->value;
  44.  
  45.   f = (Flag) allocHeap(sizeof(struct flag));
  46.   f->key = key;
  47.   f->type = FLG_INTEGER;
  48.   f->value.i = 0;
  49.   addHTable(flagTable, (void *)key, f);
  50.  
  51.   return f;
  52. }
  53.  
  54. word
  55. pl_flag(term_t name, term_t old, term_t new)
  56. { Flag f;
  57.   word key;
  58.   atom_t a;
  59.   number n;
  60.  
  61.   if ( !(key = getKey(name)) )
  62.     return warning("flag/2: illegal key");
  63.  
  64.   f = lookupFlag(key);
  65.   switch(f->type)
  66.   { case FLG_ATOM:
  67.       TRY(PL_unify_atom(old, f->value.a));
  68.       break;
  69.     case FLG_INTEGER:
  70.       TRY(PL_unify_integer(old, f->value.i));
  71.       break;
  72.     case FLG_REAL:
  73.     {
  74. #ifdef DOUBLE_ALIGNMENT
  75.       double v;
  76.       memcpy(&v, &f->value.f, sizeof(double));
  77.       TRY(PL_unify_float(old, v));
  78. #else
  79.       TRY(PL_unify_float(old, f->value.f));
  80. #endif
  81.       break;
  82.     }
  83.     default:
  84.       assert(0);
  85.   }
  86.  
  87.   if ( PL_get_atom(new, &a) )
  88.   { f->type = FLG_ATOM;
  89.     f->value.a = a;
  90.  
  91.     succeed;
  92.   } else if ( valueExpression(new, &n) )
  93.   { canoniseNumber(&n);
  94.  
  95.     if ( n.type == V_INTEGER )
  96.     { f->type = FLG_INTEGER;
  97.       f->value.i = n.value.i;
  98.     } else
  99.     { 
  100.       f->type = FLG_REAL;
  101. #ifdef DOUBLE_ALIGNMENT
  102.       memcpy(&f->value.f, &n.value.f, sizeof(double));
  103. #else
  104.       f->value.f = n.value.f;
  105. #endif
  106.     }
  107.  
  108.     succeed;
  109.   }
  110.  
  111.   return warning("flag/2: value should be an atom, integer or expression");
  112. }
  113.  
  114. word
  115. pl_current_flag(term_t k, term_t h)
  116. { Symbol symb;
  117.  
  118.   switch( ForeignControl(h) )
  119.   { case FRG_FIRST_CALL:
  120.     { word key;
  121.  
  122.       if ( (key = getKey(k)) )
  123.       { if ( lookupHTable(flagTable, (void *)key) )
  124.       succeed;
  125.     fail;
  126.       }
  127.       if ( PL_is_variable(k) )
  128.       {    symb = firstHTable(flagTable);
  129.     break;
  130.       }
  131.       return warning("current_flag/2: illegal key");
  132.     }
  133.     case FRG_REDO:
  134.       symb = ForeignContextPtr(h);
  135.       break;
  136.     case FRG_CUTTED:
  137.     default:
  138.       succeed;
  139.   }
  140.  
  141.   for( ; symb; symb = nextHTable(flagTable, symb) )
  142.   { Flag f = (Flag)symb->value;
  143.  
  144.     if ( !unifyKey(k, f->key) )
  145.       continue;
  146.  
  147.     if ( !(symb = nextHTable(flagTable, symb)) )
  148.       succeed;
  149.  
  150.     ForeignRedoPtr(symb);
  151.   }
  152.  
  153.   fail;
  154. }
  155.